
#include <assert.h>

#include "core/olisp_mem.h"
#include "utility/olisp_helpers.h"
#include "utility/olisp_printer.h"
#include "utility/olisp_utils.h"
#include "interpreter/olisp_interpreter.h"

typedef struct
{
    obj_t * func_name;
    lisp_function_proto_t proto;
} reg_func_t;

typedef struct
{
    reg_func_t * funcs;
    size_t length;
    size_t allocated;
} reg_funcs_t;

#define REG_FUNC_GROW_SIZE 256

static int add_reg_func( reg_funcs_t * r, obj_t * func_name, lisp_function_proto_t proto )
{
    size_t new_len = r->length + 1;
    reg_func_t * d;
    if( new_len > r->allocated )
    {
        size_t new_alloc = r->allocated + REG_FUNC_GROW_SIZE;
        reg_func_t * new_funcs = lisp_realloc( r->funcs, new_alloc * sizeof(reg_func_t) );
        if( !new_funcs )
            return 0;

        r->allocated = new_alloc;
        r->funcs = new_funcs;
    }

    d = r->funcs + r->length;
    d->func_name = func_name;
    d->proto = proto;

    r->length = new_len;

    return 1;
}

static lisp_function_proto_t find_proto( reg_funcs_t * r, obj_t * func_name )
{
    size_t n;
    for( n = 0; n < r->length; ++ n )
    {
        if( lisp_equal(r->funcs[n].func_name, func_name) )
        {
            return r->funcs[n].proto;
        }
    }

    return 0;
}

static void dispose_reg_func( reg_funcs_t * r )
{
    size_t n;
    
    // release each name
    for( n = 0; n < r->length; ++ n )
    {
        RELEASE( r->funcs[n].func_name );
    }

    if( r->funcs )
    {
        lisp_free( r->funcs );
    }
}

/*
 * an interpreter's implementation
 */
typedef struct
{
    interpreter_vtbl_t * vtbl;

    interpreter_context * interp_ctx;

    reg_funcs_t reg_funcs;
} interp_impl_t;



static void ir_dispose( interpreter_t * self )
{
    interp_impl_t * s = (interp_impl_t *)self;
    
    dispose_reg_func( &s->reg_funcs );
    lisp_free( s );
}


static void ir_message( interpreter_t * self, int severity,
    obj_t * location, const char * msg )
{
    interp_impl_t * s = (interp_impl_t *)self;
    FILE * stream = s->interp_ctx->err_stream;

    // if error feedback stream is not assigned - just return back
    if( !stream )
        return;

    switch( severity )
    {
    case MSG_SEV_ERROR:
        fputs( "error", stream );
        break;

    case MSG_SEV_WARNING:
        fputs( "warning", stream );
        break;

    default:
        fputs( "unknown message", stream );
    }

    // print location
    if( location )
    {
        printer_context prn_ctx = { 0 };
#ifdef LISP_FEAT_QUOTE_SUPPORT
        prn_ctx.quote_mgr = s->interp_ctx->quote_mgr;
#endif
        prn_ctx.stream = stream;

        fputs( " at ", stream );
        print_elem( location, &prn_ctx );
    }
    
    fputs( ": ", stream );

    fputs( msg, stream );

    fputc( '\n', stream );
}

/*
 * does all preprocessor work on-place
 */
static list_obj_t * preprocess_args( interpreter_t * self, list_obj_t * func_call )
{
    size_t n;
    size_t len = list_length( func_call );
    list_obj_t * res = create_list( 0 );
    if( !res )
        return 0;

    for( n = 0; n < len; ++ n )
    {
        obj_t * proc_item = interpreter_interpret( self, list_get_elem(func_call, n) );
        if( !proc_item )
            goto LFail;

        if( !list_append(res, proc_item) )
            goto LFail;

        RELEASE( proc_item );
    }

    return res;

LFail:
    RELEASE( res );
    return 0;
}

/*
 * interpreter::interpret
 */
static obj_t * ir_interpret( interpreter_t * self, obj_t * elem )
{
    interp_impl_t * s = (interp_impl_t *)self;

#ifdef LISP_FEAT_QUOTE_SUPPORT
    int quote_marker;

    if( s->interp_ctx->quote_mgr )
    {
        quote_marker = quote_mgr_get_marker( s->interp_ctx->quote_mgr, elem );
        switch( quote_marker )
        {
        case QUOTE_STRIGHT:
            ADDREF( elem );
            return elem;

        case QUOTE_BACK:
            interpreter_message( self, MSG_SEV_ERROR,
                elem, "back quote is acceptable only in macro body" );
            return 0;
        }
    }
#endif

    // makes function call with preprocessed arguments
    // it is required to make all the macro substitutions before
    if( elem->vtbl->element_type == LISP_ELEM_LIST )
    {
        list_obj_t * func_call = (list_obj_t *)elem;
        list_obj_t * pp_args;
        obj_t * result = 0;
        lisp_function_proto_t proto;

        proto = find_proto( &s->reg_funcs, list_get_elem(func_call, 0) );
        if( !proto )
        {
            interpreter_message( self, MSG_SEV_ERROR, elem, "unknown function" );
            return 0;
        }

        pp_args = preprocess_args( self, func_call );
        if( pp_args )
        {
            result = proto( self, pp_args );
            RELEASE( pp_args );
        }
        return result;
    }

    // just return the same elem
    ADDREF( elem );
    return elem;
}

static int ir_add_func( interpreter_t * self,
        obj_t * func_name, lisp_function_proto_t proto )
{
    interp_impl_t * s = (interp_impl_t *)self;
    return add_reg_func( &s->reg_funcs, func_name, proto );
}

static interpreter_vtbl_t interp_impl_vtbl =
{
    &ir_dispose,
    &ir_message,
    &ir_interpret,
    &ir_add_func
};

interpreter_t * create_interpreter( interpreter_context * ctx )
{
    interp_impl_t * s = lisp_mallocz( sizeof(interp_impl_t) );
    if( s )
    {
        s->vtbl = &interp_impl_vtbl;
        s->interp_ctx = ctx;

        return (interpreter_t *)s;
    }

    return 0;
}
